home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / telecomm / fido / pltprg05.lha / PlutPurge.LST < prev    next >
Encoding:
File List  |  1995-01-30  |  3.7 KB  |  202 lines
  1. MODE 1
  2. '
  3. ' Plutonic Outbound Purger
  4. '
  5. ' This source is copyright!  All rights reserved.
  6. '
  7. ' If any parts of it are used in other programs, acknowledgement
  8. ' must be given to Peter Deane (3:622/401)
  9. '
  10. ' Only keeps today's 0-byte files in outbound.
  11. '
  12. argprob%=0
  13. arg$=_dosCmd$
  14. arg$=TRIM$(arg$)
  15. IF arg$=""
  16.   arg$="Mail:Outbound"
  17. ENDIF
  18. '
  19. versnum$="$VER: PlutPurge 0.5 (30-Jan-95)kyj"
  20. versnum$="0.5"
  21. versdate$="30-Jan-95"
  22. '
  23. esc$=CHR$(27)
  24. ansi0$=esc$+"[0m"
  25. ansi1$=esc$+"[31m"
  26. ansi2$=esc$+"[32m"
  27. ansi3$=esc$+"[33m"
  28. bold$=esc$+"[1m"
  29. ital$=esc$+"[3m"
  30. under$=esc$+"[4m"
  31. '
  32. numkill%=0
  33. '
  34. OPEN "O",#1,"*",1
  35. '
  36. IF INSTR(arg$,"?")
  37.   argprob%=9
  38. ELSE IF LEN(arg$)<3
  39.   argprob%=1
  40. ELSE IF NOT EXIST(arg$)
  41.   argprob%=2
  42. ENDIF
  43. '
  44. PRINT #1,""
  45. PRINT #1,ansi2$+"---------------"
  46. PRINT #1,ansi0$+bold$+"Plutonic Purger"+ansi0$
  47. PRINT #1,ansi2$+"---------------"
  48. PRINT #1,under$+ansi0$+"Version "+ansi3$+versnum$+ansi0$
  49. PRINT #1,ital$+" (c) "+ansi3$+versdate$+ansi0$
  50. PRINT #1,bold$;" By Peter Deane"+ansi0$
  51. PRINT #1,ansi2$+"---------------"+ansi0$
  52. RELSEEK #1,0
  53. '
  54. IF argprob%>0
  55.   '
  56.   PRINT #1,""
  57.   IF argprob%=1
  58.     PRINT #1,"Short or no directory name given"
  59.   ELSE IF argprob%=2
  60.     PRINT #1,"Given directory does not exist"
  61.   ELSE IF argprob%=9
  62.     PRINT #1,CHR$(34)+"?"+CHR$(34)+" given in command line"
  63.   ENDIF
  64.   PRINT #1,bold$+ansi3$+"Usage details: ";
  65.   PRINT #1,ansi2$+"PlutPurge "+ital$+"<directory>"+ansi0$
  66.   GOTO cleanup
  67. ENDIF
  68. '
  69. IF RIGHT$(arg$,1)<>"/" AND RIGHT$(arg$,1)<>":"
  70.   arg$=arg$+"/"
  71. ENDIF
  72. '
  73. @gimmetheday
  74. keep$="."+LEFT$(today$,2)
  75. keep$=UPPER$(keep$)
  76. '
  77. PRINT #1
  78. PRINT #1,"Scanning dir: "+CHR$(34)+arg$+CHR$(34)+" this fine "+today$+"..."
  79. RELSEEK #1,-1
  80. '
  81. DIR arg$ TO "ram:PlutPurge.tmp"
  82. IF NOT EXIST("Ram:PlutPurge.tmp")
  83.   PRINT #1,"No files in search directory"
  84.   RELSEEK #1,-1
  85.   GOTO cleanup
  86. ENDIF
  87. '
  88. OPEN "I",#3,"Ram:PlutPurge.tmp",1024
  89. PRINT #1,""
  90. RELSEEK #1,-1
  91. WHILE NOT EOF(#3)
  92.   lq%=0
  93.   LINE INPUT #3,xx$
  94.   PRINT #1,xx$;
  95.   RELSEEK #1,-1
  96.   '
  97.   xk$=arg$+xx$+CHR$(0)
  98.   xop%=Lock(V:xk$,-1)
  99.   IF xop%<>0
  100.     ~UnLock(xop%)
  101.     OPEN "I",#9,arg$+xx$,24
  102.     lq%=LOF(#9)
  103.     CLOSE #9
  104.   ENDIF
  105.   IF lq%=0
  106.     '
  107.     xxu$=UPPER$(xx$)
  108.     spc%=24-LEN(xx$)
  109.     IF spc%<1
  110.       spc%=1
  111.     ENDIF
  112.     PRINT #1,SPACE$(spc%);
  113.     IF INSTR(xxu$,keep$)
  114.       PRINT #1," <- "+ansi2$+"Today's"+ansi0$
  115.     ELSE
  116.       xk$=arg$+xx$+CHR$(0)
  117.       xop%=Lock(V:xk$,-1)
  118.       IF xop%<>0
  119.         ~UnLock(xop%)
  120.         KILL arg$+xx$
  121.         INC numkill%
  122.         PRINT #1," <- "+ansi3$+"Deleted!"+ansi0$
  123.       ELSE
  124.         PRINT #1," <- Locked - not deleted"+ansi0$
  125.       ENDIF
  126.     ENDIF
  127.     RELSEEK #1,-1
  128.   ELSE
  129.     PRINT #1,CHR$(10)+esc$+"[A"+esc$+"[K";
  130.     RELSEEK #1,-1
  131.   ENDIF
  132. WEND
  133. CLOSE #3
  134. '
  135. cleanup:
  136. '
  137. PRINT #1,"Deleted "+STR$(numkill%)+" files."
  138. PRINT #1,""
  139. PRINT #1,ansi3$+"Peter Deane"
  140. PRINT #1,ansi0$+"PO Box 228"
  141. PRINT #1,"Swansea  NSW  2281 Australia."
  142. PRINT #1,bold$+ansi3$+"Fido: "+ansi2$+"3:622/401"+ansi0$
  143. '
  144. IF EXIST("Ram:PlutPurge.tmp")
  145.   KILL "RAM:PlutPurge.tmp"
  146. ENDIF
  147. '
  148. CLOSE #1
  149. END
  150. '
  151. '
  152. PROCEDURE gimmetheday
  153.   '
  154.   dshold%=AllocMem(12,0)
  155.   ' Can one assume that 12 bytes can always get allocated? I am here!
  156.   ~DateStamp(dshold%)
  157.   xd%=LPEEK(dshold%)
  158.   ~FreeMem(dshold%,12)
  159.   dd%=xd% MOD 7
  160.   SELECT dd%
  161.   CASE 0
  162.     today$="Sunday"
  163.   CASE 1
  164.     today$="Monday"
  165.   CASE 2
  166.     today$="Tuesday"
  167.   CASE 3
  168.     today$="Wednesday"
  169.   CASE 4
  170.     today$="Thursday"
  171.   CASE 5
  172.     today$="Friday"
  173.   CASE 6
  174.     today$="Saturday"
  175.   ENDSELECT
  176.   '
  177. RETURN
  178. '
  179. '
  180. PROCEDURE spaceout(thing$,col%)
  181.   '
  182.   LOCAL xx$,xx%,xq%,result%
  183.   '
  184.   xx%=FRE(1)
  185.   ' [Needs the string to format, and the column width it's going to]
  186.   ' [Returns spc% - the number of spaces required - 1 if field overflow]
  187.   '
  188.   xx$=thing$
  189.   xx%=col%
  190.   xq%=LEN(xx$)
  191.   '
  192.   IF xq%>xx%
  193.     result%=1
  194.   ELSE
  195.     result%=(xx%-xq%)
  196.   ENDIF
  197.   '
  198.   spc%=result%
  199.   '
  200. RETURN
  201. '
  202.